home *** CD-ROM | disk | FTP | other *** search
/ CD ROM Paradise Collection 4 / CD ROM Paradise Collection 4 1995 Nov.iso / program / swagg_m.zip / GRAPHICS.SWG / 0037_Quick PutImage.pas < prev    next >
Pascal/Delphi Source File  |  1993-11-02  |  3KB  |  89 lines
  1. {
  2. NICK ONOUFRIOU
  3.  
  4. I'm writing a small game that requires a transparent putimage Function. I
  5. normally use the BGI, but in this Case I need a little bit more speed. This
  6. partial Program shows what I have already. What I want to know is there is
  7. simple method of masking color 0 so it won't be displayed.
  8. }
  9. Program PutMan;
  10.  
  11. Uses
  12.   Dos, Crt;
  13.  
  14. Const
  15. (* Turbo Pascal, Width= 11 Height= 23 Colors= 256 *)
  16.  
  17.   Man : Array [1..259] of Byte = (
  18.           $0A,$00,$16,$00,$00,$00,$00,$00,$00,$00,$00,$00,
  19.           $00,$00,$00,$00,$00,$00,$00,$02,$02,$02,$00,$00,
  20.           $00,$00,$00,$00,$00,$02,$02,$02,$02,$02,$00,$00,
  21.           $00,$00,$00,$02,$2C,$2C,$2C,$2C,$2C,$02,$00,$00,
  22.           $00,$00,$2C,$10,$10,$2C,$10,$10,$2C,$00,$00,$00,
  23.           $00,$2C,$2C,$2C,$2C,$2C,$2C,$2C,$00,$00,$00,$00,
  24.           $00,$2C,$0C,$0C,$0C,$2C,$00,$00,$00,$00,$00,$00,
  25.           $00,$2C,$2C,$2C,$00,$00,$00,$00,$00,$00,$00,$00,
  26.           $00,$0F,$00,$00,$00,$00,$00,$00,$0F,$00,$00,$0F,
  27.           $0F,$0F,$00,$00,$00,$00,$00,$0F,$00,$0D,$0D,$0D,
  28.           $0D,$0D,$00,$00,$00,$00,$0F,$0D,$0D,$0D,$0D,$0D,
  29.           $0D,$0D,$00,$00,$00,$0F,$1F,$1F,$1F,$1F,$1F,$1F,
  30.           $1F,$0F,$00,$00,$00,$1F,$1F,$1F,$1F,$1F,$1F,$1F,
  31.           $0F,$00,$00,$00,$00,$1F,$1F,$1F,$1F,$1F,$00,$0F,
  32.           $00,$00,$00,$00,$00,$0D,$0D,$0D,$00,$00,$0F,$00,
  33.           $00,$00,$00,$0D,$0D,$0D,$0D,$0D,$00,$00,$00,$00,
  34.           $00,$00,$0D,$0D,$0D,$0D,$0D,$00,$00,$00,$00,$00,
  35.           $00,$0D,$0D,$00,$0D,$0D,$00,$00,$00,$00,$00,$00,
  36.           $0D,$0D,$00,$0D,$0D,$00,$00,$00,$00,$00,$00,$07,
  37.           $07,$00,$07,$07,$00,$00,$00,$00,$00,$00,$07,$07,
  38.           $00,$07,$07,$00,$00,$00,$00,$00,$00,$00,$00,$00,
  39.           $00,$00,$00,$00,$00,$00,$00);
  40.  
  41. Type
  42.   _screenRec = Array [0..199, 0..319] of Byte;
  43.  
  44. Var
  45.   _mcgaScreen  : _screenRec Absolute $A000:0000;
  46.  
  47.  
  48. Procedure SetMode(mode : Integer);
  49. Var
  50.   regs : Registers;
  51. begin
  52.   regs.ah := 0;
  53.   regs.al := mode;
  54.   intr($10, regs);
  55. end;
  56.  
  57. Procedure ClearPage(color : Integer);
  58. begin
  59.   FillChar(_mcgaScreen, 64000, color);
  60. end;
  61.  
  62. Procedure PutImg(x, y : Integer; Var Img);
  63. Type
  64.   AList = Array[1..$FFFF] of Byte;
  65. Var
  66.   APtr      : ^AList;
  67.   J, Width,
  68.   Height,
  69.   Counter   : Word;
  70. begin
  71.   Aptr    := @Img;
  72.   Width   := (Aptr^[2] SHL 8) + Aptr^[1] + 1;
  73.   Height  := (Aptr^[4] SHL 8) + Aptr^[3] + 1;
  74.   Counter := 5;
  75.   For j := y to (y + height - 1) do
  76.   begin
  77.     Move(Aptr^[Counter], _mcgaScreen[j, x], Width);
  78.     Inc(Counter, Width);
  79.   end;
  80. end;
  81.  
  82. begin
  83.   SetMode(19);
  84.   ClearPage(Blue);
  85.   PutImg(150, 80, Ptr(seg(man), ofs(man))^);
  86.   readln;
  87.   SetMode(3);
  88. end.
  89.